COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY smooth
C00005 00003	IF BYTZ=1 THEN BEGIN "BYTESIZE = 1"
C00007 00004	ELSE BEGIN "BYTESIZE ≠ 1"
C00010 ENDMK
C⊗;
ENTRY smooth;
BEGIN "smoothH"
REQUIRE "BAYSAI.SAI" SOURCE!FILE;
SOURCE!V(PICBUF.DCL);
SOURCE!L(UTILS.DCL);
REQUIRE "36A" COMPILER!SWITCHES;

SIMPLE INTERNAL INTEGER PROCEDURE smooth(INTEGER IBUFF,winI,winJ; Real fract; integer diver);

BEGIN "smooth"



SIMPLE INTEGER PROCEDURE CEILING(REAL VAL);
	BEGIN
	INTEGER IVAL;
	RETURN(IF (IVAL←VAL)=VAL THEN IVAL ELSE IVAL+1);
	END;


INTEGER WMINI,WPLSI,WMINJ,WPLSJ,IMIN,JMIN,IMAX,JMAX,ROW,COL,OBUFF,I,II,
	J,JJ,SUM,PTRO,PTRI,PTRTL,PTRTR,PTRBL,PTRBR,JLO,BBUFF,BPTR,BYTZ,
	SUMI,FACT;

simple procedure smcol(integer i,js,je,val);
    begin
    integer j,opt;
    opt←outptr(i,js,obuff);
    for j←js thru je do
	idpb(val,opt);
    end;

simple procedure smrow(integer ist,ie,ival);
    begin
    integer i,j,ipt,opt;
    for i←ist thru ie do
	begin
	ipt←inptr(ival,1,obuff);
	opt←outptr(i,1,obuff);
	for j←1 thru col do
	    idpb(ildb(ipt),opt)
	end;
    end;

WMINI←(winI-1)/2;
WPLSI←winI/2;
WMINJ←(winJ-1)/2;
WPLSJ←winJ/2;
FACT←WINI*WINJ;

IF DIVER THEN 
	BEGIN
	FOR BYTZ←1 THRU FACT DO 
	    IF (2↑BYTZ)≥FACT THEN DONE;
	FACT←1;
	END
ELSE BYTZ←BYTSZ(IBUFF);


IMIN←WMINI+1;		IMAX←(ROW←ROWS(IBUFF))-WPLSI;
JMIN←WMINJ+1;		JMAX←(COL←COLMS(IBUFF))-WPLSJ;
PAGMIN((wini+5) MAX 10);
GETBUF(ROW,COL,BYTZ,OBUFF←FNDBUF(0));
PUTSUB(ISUBST(IBUFF),JSUBST(IBUFF),OBUFF);
IF NOT DIVER THEN COPY(IBUFF,OBUFF);
GETBUF(1,COL,36,BBUFF←FNDBUF(-1));

PTRO←OUTPTR(IMIN,JMIN,OBUFF);
BPTR←OUTPTR(1,JMIN,BBUFF);
IF BYTZ=1 THEN BEGIN "BYTESIZE = 1"

INTEGER CRITVAL;
CRITVAL←CEILING((1-FRACT)*FACT);
FOR J←JMIN THRU JMAX DO
    BEGIN "JL"
    JLO←J-WMINJ;
    SUM←0;
    FOR II←1 THRU winI DO
	BEGIN "IIL"
	PTRI←INPTR(II,JLO,IBUFF);
	FOR JJ←1 THRU winJ DO
		SUM←SUM+ILDB(PTRI);
	END "IIL";
    IDPB(SUM≥CRITVAL,PTRO);
    IDPB(SUM,BPTR);
    END;
! WELL THATS THE END OF THE FIRST ROW NOW FOR THE FAST PART;
! THE FIRST COL IS DIFFERENT AND THE REST ARE FASTER;

FOR I←IMIN+1 THRU IMAX DO
    BEGIN "IL"
    PTRO←OUTPTR(I,JMIN,OBUFF);
    BPTR←INPTR(1,JMIN,BBUFF);
    PTRTL←PTRTR←INPTR(I-WMINI-1,1,IBUFF);
    PTRBL←PTRBR←INPTR(I+WPLSI,1,IBUFF);
    SUM←0;
    FOR JJ←1 THRU winJ DO
	SUM←SUM+ILDB(PTRBR)-ILDB(PTRTR);
    SUMi←SUM+ILDB(BPTR);
    IDPB(SUMI≥CRITVAL,PTRO);
    DPB(SUMi,BPTR);
    FOR J←JMIN+1 THRU JMAX DO
	BEGIN "JLL"
	SUM←SUM-ILDB(PTRBL)+ILDB(PTRBR)+ILDB(PTRTL)-ILDB(PTRTR);
	SUMi←SUM+ILDB(BPTR);
	IDPB(SUMI≥CRITVAL,PTRO);
	DPB(SUMi,BPTR);
	END "JLL";
    rowchk(CHKROW,rows,i,CHKROW);
    END "IL";
END "BYTESIZE = 1"
ELSE BEGIN "BYTESIZE ≠ 1"

INTEGER ROUND;
ROUND←FRACT*FACT;
FOR J←JMIN THRU JMAX DO
    BEGIN "JL"
    JLO←J-WMINJ;
    SUM←ROUND;
    FOR II←1 THRU winI DO
	BEGIN "IIL"
	PTRI←INPTR(II,JLO,IBUFF);
	FOR JJ←1 THRU winJ DO
		SUM←SUM+ILDB(PTRI);
	END "IIL";
    IDPB(SUM DIV FACT,PTRO);
    IDPB(SUM,BPTR);
    END;
! WELL THATS THE END OF THE FIRST ROW NOW FOR THE FAST PART;
! THE FIRST COL IS DIFFERENT AND THE REST ARE FASTER;
! now for the smearing the boundaries;
if diver
    then begin
	smcol(imin,1,jmin-1,getpnt(imin,jmin,obuff));
	smcol(imin,jmax+1,col,getpnt(imin,jmax,obuff));
	smrow(1,imin-1,imin);
	end;

FOR I←IMIN+1 THRU IMAX DO
    BEGIN "IL"
    PTRO←OUTPTR(I,JMIN,OBUFF);
    BPTR←INPTR(1,JMIN,BBUFF);
    PTRTL←PTRTR←INPTR(I-WMINI-1,1,IBUFF);
    PTRBL←PTRBR←INPTR(I+WPLSI,1,IBUFF);
    SUM←0;
    FOR JJ←1 THRU winJ DO
	SUM←SUM+ILDB(PTRBR)-ILDB(PTRTR);
    SUMI←SUM+ILDB(BPTR);
    IDPB(SUMI DIV FACT,PTRO);
    if diver then smcol(i,1,jmin-1,sumi);		! smear col;
    DPB(SUMi,BPTR);
    FOR J←JMIN+1 THRU JMAX DO
	BEGIN "JLL"
	SUM←SUM-ILDB(PTRBL)+ILDB(PTRBR)+ILDB(PTRTL)-ILDB(PTRTR);
	SUMI←SUM+ILDB(BPTR);
	IDPB(SUMI DIV FACT,PTRO);
	DPB(SUMi,BPTR);
	END "JLL";
    if diver then smcol(i,jmax+1,col,sumi);
    rowchk(CHKROW,rows,i,CHKROW);
    END "IL";

if diver then smrow(imax+1,row,imax);
END "BYTESIZE ≠ 1";
! THATS IT;
frebuf(bbuff);
RETURN(OBUFF);

END "smooth";

END "smoothH";